home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cocktail / cg.lha / cg / src / Errors.mi < prev    next >
Text File  |  1992-11-24  |  14KB  |  365 lines
  1. (* $Id: Errors.mi,v 1.0 1992/08/07 14:41:59 grosch rel $ *)
  2.  
  3. (* $Log: Errors.mi,v $
  4.  *)
  5.  
  6. (* Ich, Doktor Josef Grosch, Informatiker, Juli 1992 *)
  7.  
  8. IMPLEMENTATION MODULE Errors;
  9.  
  10. FROM SYSTEM    IMPORT ADDRESS, TSIZE, ADR;
  11. FROM Memory    IMPORT Alloc;
  12. FROM IO        IMPORT tFile, StdError, WriteC, WriteNl, WriteS, WriteI,
  13.                WriteB, WriteR, CloseIO;
  14. FROM Positions    IMPORT tPosition, Compare, WritePosition;
  15. FROM StringMem    IMPORT tStringRef, PutString, GetString;
  16. FROM Strings    IMPORT tString, ArrayToString, StringToArray;
  17. FROM Idents    IMPORT tIdent, WriteIdent, MakeIdent;
  18. FROM Sets    IMPORT tSet, WriteSet, Assign, MakeSet, Size;
  19. FROM Sort    IMPORT Sort;
  20.  
  21. IMPORT System, Strings;
  22.  
  23. CONST MaxError    = 300;
  24. AssignmentWithIncorrectLeftHandSide    = 10    ;
  25. CopyRuleWithIncorrectLeftHandSide    = 11    ;
  26. BlockWithIncorrectLeftHandSide    = 12    ;
  27. CheckWithoutStatement    = 13    ;
  28. InheritedUseOfSynthesizedAttribute    = 14    ;
  29. AttributeMultipleComputed    = 15    ;
  30. AttributeNotDeclared    = 16    ;
  31. SelectorNotDeclared    = 17    ;
  32. SynthesizedUseOfInheritedAttribute    = 18    ;
  33. CopyRuleInsertionsInherited    = 19    ;
  34. CopyRuleInsertionsSynthesized    = 20    ;
  35. CopyRuleInsertionsThreaded    = 21    ;
  36. ModuleNotDeclared    = 22    ;
  37. TerminalCodeMultipleUsed    = 23    ;
  38. NodeTypeNotDeclared    = 24    ;
  39. OnlyOneReverseInNodeType    = 25    ;
  40. NodeTypeMultipleDeclared    = 26    ;
  41. VariantSelectorMultipleDeclared    = 27    ;
  42. PrecedenceNotDeclared    = 28    ;
  43. SelectorMultipleDeclared    = 29    ;
  44. PrecedenceMultipleDeclared    = 30    ;
  45. AbstractTypeRequired    = 31    ;
  46. ChildRequired    = 32    ;
  47. AttributeNeverSet    = 33    ;
  48. AttributeNeverUsed    = 34    ;
  49. InputAttributeIsSet    = 35    ;
  50. AttributeSynthesizedAsWellAsInherited    = 36    ;
  51. NodeTypeNotUsed    = 37    ;
  52. InheritedAttributesOnlyInBaseClasses    = 38    ;
  53. AttributeComputationMissing    = 39    ;
  54. CycleInLocalDependenciesDP    = 40    ;
  55. GrammarIsInNormalForm    = 50    ;
  56. GrammarIsNotInNormalForm    = 51    ;
  57. SwitchedOnOptionL    = 52    ;
  58. GrammarIsSAG    = 53    ;
  59. GrammarIsLAG    = 54    ;
  60. GrammarIsOAG    = 55    ;
  61. GrammarIsDNC    = 56    ;
  62. GrammarIsSNC    = 57    ;
  63. GrammarIsWAG    = 58    ;
  64. GrammarIsNotWAG    = 59    ;
  65. CycleInSNC    = 60    ;
  66. CycleInDNC    = 61    ;
  67. CycleInOAG    = 62    ;
  68. InternalErrorCompOAG    = 63    ;
  69. CycleInWAG    = 64    ;
  70.  
  71. TYPE tArray    = ARRAY [0..255] OF CHAR;
  72.  
  73. TYPE tError    = RECORD
  74.                        Position    : tPosition    ;
  75.                        IsErrorCode    : BOOLEAN    ;
  76.                        ErrorNumber    : SHORTCARD    ;
  77.                        ErrorCode    : SHORTCARD    ;
  78.                        ErrorClass    : SHORTCARD    ;
  79.              CASE      InfoClass    : SHORTCARD    OF
  80.              | None    :
  81.              | Integer    : vInteger    : INTEGER    ;
  82.              | Short    : vShort    : SHORTCARD    ;
  83.              | Long    : vLong        : LONGINT    ;
  84.              | Real    : vReal        : REAL        ;
  85.              | Boolean    : vBoolean    : BOOLEAN    ;
  86.              | Character: vCharacter    : CHAR        ;
  87.              | String    : vString    : tStringRef    ;
  88.              | Array    : vArray    : tStringRef    ;
  89.              | Set    : vSet        : POINTER TO tSet;
  90.              | Ident    : vIdent    : tIdent    ;
  91.              END;
  92.           END;
  93.  
  94. VAR
  95.    ErrorTable    : ARRAY [0..MaxError] OF tError;
  96.    MessageCount    : INTEGER;
  97.    IsStore    : BOOLEAN;
  98.    HandleMessage: PROCEDURE (BOOLEAN, CARDINAL, CARDINAL, tPosition, CARDINAL, ADDRESS);
  99.    Out        : tFile;
  100.  
  101. PROCEDURE ErrorMessage    (ErrorCode, ErrorClass: CARDINAL; Position: tPosition);
  102.    BEGIN
  103.       HandleMessage (TRUE, ErrorCode, ErrorClass, Position, None, NIL);
  104.    END ErrorMessage;
  105.  
  106. PROCEDURE ErrorMessageI    (ErrorCode, ErrorClass: CARDINAL; Position: tPosition;
  107.              InfoClass: CARDINAL; Info: ADDRESS);
  108.    BEGIN
  109.       HandleMessage (TRUE, ErrorCode, ErrorClass, Position, InfoClass, Info);
  110.    END ErrorMessageI;
  111.  
  112. PROCEDURE Message  (ErrorText: ARRAY OF CHAR; ErrorClass: CARDINAL; Position: tPosition);
  113.    VAR String    : tString;
  114.    BEGIN
  115.       ArrayToString (ErrorText, String);
  116.       HandleMessage (FALSE, MakeIdent (String), ErrorClass, Position, None, NIL);
  117.    END Message;
  118.  
  119. PROCEDURE MessageI (ErrorText: ARRAY OF CHAR; ErrorClass: CARDINAL; Position: tPosition;
  120.              InfoClass: CARDINAL; Info: ADDRESS);
  121.    VAR String    : tString;
  122.    BEGIN
  123.       ArrayToString (ErrorText, String);
  124.       HandleMessage (FALSE, MakeIdent (String), ErrorClass, Position, InfoClass, Info);
  125.    END MessageI;
  126.  
  127. PROCEDURE WriteHead (Position: tPosition; ErrorClass: CARDINAL);
  128.    BEGIN
  129.       WritePosition (Out, Position);
  130.       WriteS    (Out, ": ");
  131.       CASE ErrorClass OF
  132.       |  Fatal        : WriteS (Out, "Fatal       ");
  133.       |  Restriction    : WriteS (Out, "Restriction ");
  134.       |  Error        : WriteS (Out, "Error       ");
  135.       |  Warning    : WriteS (Out, "Warning     ");
  136.       |  Repair        : WriteS (Out, "Repair      ");
  137.       |  Note        : WriteS (Out, "Note        ");
  138.       |  Information    : WriteS (Out, "Information ");
  139.       ELSE WriteS (Out, "Error class: "); WriteI (Out, ErrorClass, 0);
  140.       END;
  141.    END WriteHead;
  142.  
  143. PROCEDURE WriteCode (ErrorCode: CARDINAL);
  144.    BEGIN
  145.       CASE ErrorCode OF
  146.       |  NoText        :
  147.       |  SyntaxError    : WriteS (Out, "syntax error"        );
  148.       |  ExpectedTokens    : WriteS (Out, "expected tokens"    );
  149.       |  RestartPoint    : WriteS (Out, "restart point"        );
  150.       |  TokenInserted    : WriteS (Out, "token inserted "    );
  151.       |  WrongParseTable: WriteS (Out, "parse table mismatch"    );
  152.       |  OpenParseTable    : WriteS (Out, "cannot open parse table");
  153.       |  ReadParseTable    : WriteS (Out, "cannot read parse table");
  154.       |  TooManyErrors    : WriteS (Out, "too many errors"    );
  155. | AssignmentWithIncorrectLeftHandSide     : WriteS (StdError, "assignment with incorrect left hand side");
  156. | CopyRuleWithIncorrectLeftHandSide     : WriteS (StdError, "copy rule with incorrect left hand side");
  157. | BlockWithIncorrectLeftHandSide     : WriteS (StdError, "block with incorrect left hand side");
  158. | CheckWithoutStatement     : WriteS (StdError, "check without statement");
  159. | InheritedUseOfSynthesizedAttribute     : WriteS (StdError, "inherited use of synthesized attribute");
  160. | AttributeMultipleComputed     : WriteS (StdError, "attribute multiple computed");
  161. | AttributeNotDeclared     : WriteS (StdError, "attribute not declared");
  162. | SelectorNotDeclared     : WriteS (StdError, "selector not declared");
  163. | SynthesizedUseOfInheritedAttribute     : WriteS (StdError, "synthesized use of inherited attribute");
  164. | CopyRuleInsertionsInherited     : WriteS (StdError, "copy rule insertions inherited");
  165. | CopyRuleInsertionsSynthesized     : WriteS (StdError, "copy rule insertions synthesized");
  166. | CopyRuleInsertionsThreaded     : WriteS (StdError, "copy rule insertions threaded");
  167. | ModuleNotDeclared     : WriteS (StdError, "module not declared");
  168. | TerminalCodeMultipleUsed     : WriteS (StdError, "terminal code multiple used");
  169. | NodeTypeNotDeclared     : WriteS (StdError, "node type not declared");
  170. | OnlyOneReverseInNodeType     : WriteS (StdError, "only one reverse in node type");
  171. | NodeTypeMultipleDeclared     : WriteS (StdError, "node type multiple declared");
  172. | VariantSelectorMultipleDeclared     : WriteS (StdError, "variant selector multiple declared");
  173. | PrecedenceNotDeclared     : WriteS (StdError, "precedence not declared");
  174. | SelectorMultipleDeclared     : WriteS (StdError, "selector multiple declared");
  175. | PrecedenceMultipleDeclared     : WriteS (StdError, "precedence multiple declared");
  176. | AbstractTypeRequired     : WriteS (StdError, "abstract type required");
  177. | ChildRequired     : WriteS (StdError, "child required");
  178. | AttributeNeverSet     : WriteS (StdError, "attribute never set");
  179. | AttributeNeverUsed     : WriteS (StdError, "attribute never used");
  180. | InputAttributeIsSet     : WriteS (StdError, "input attribute is set");
  181. | AttributeSynthesizedAsWellAsInherited     : WriteS (StdError, "attribute synthesized as well as inherited");
  182. | NodeTypeNotUsed     : WriteS (StdError, "node type not used");
  183. | InheritedAttributesOnlyInBaseClasses     : WriteS (StdError, "inherited attributes only in base classes");
  184. | AttributeComputationMissing     : WriteS (StdError, "attribute computation missing");
  185. | CycleInLocalDependenciesDP     : WriteS (StdError, "cycle in local dependencies DP");
  186. | GrammarIsInNormalForm     : WriteS (StdError, "grammar is in normal form");
  187. | GrammarIsNotInNormalForm     : WriteS (StdError, "grammar is not in normal form");
  188. | SwitchedOnOptionL     : WriteS (StdError, "switched on option L");
  189. | GrammarIsSAG     : WriteS (StdError, "grammar is SAG");
  190. | GrammarIsLAG     : WriteS (StdError, "grammar is LAG");
  191. | GrammarIsOAG     : WriteS (StdError, "grammar is OAG");
  192. | GrammarIsDNC     : WriteS (StdError, "grammar is DNC");
  193. | GrammarIsSNC     : WriteS (StdError, "grammar is SNC");
  194. | GrammarIsWAG     : WriteS (StdError, "grammar is WAG");
  195. | GrammarIsNotWAG     : WriteS (StdError, "grammar is not WAG");
  196. | CycleInSNC     : WriteS (StdError, "cycle in SNC");
  197. | CycleInDNC     : WriteS (StdError, "cycle in DNC");
  198. | CycleInOAG     : WriteS (StdError, "cycle in OAG");
  199. | InternalErrorCompOAG     : WriteS (StdError, "internal error comp OAG");
  200. | CycleInWAG     : WriteS (StdError, "cycle in WAG");
  201.       ELSE WriteS (Out, " error code: "); WriteI (Out, ErrorCode, 0);
  202.       END;
  203.    END WriteCode;
  204.  
  205. PROCEDURE WriteInfo (InfoClass: CARDINAL; Info: ADDRESS);
  206.    VAR
  207.       PtrToInteger    : POINTER TO INTEGER;
  208.       PtrToShort    : POINTER TO SHORTCARD;
  209.       PtrToLong        : POINTER TO LONGINT;
  210.       PtrToReal        : POINTER TO REAL;
  211.       PtrToBoolean    : POINTER TO BOOLEAN;
  212.       PtrToCharacter    : POINTER TO CHAR;
  213.       PtrToString    : POINTER TO tString;
  214.       PtrToArray    : POINTER TO tArray;
  215.       PtrToSet        : POINTER TO tSet;
  216.       PtrToIdent    : POINTER TO tIdent;
  217.    BEGIN
  218.       IF InfoClass = None THEN RETURN; END;
  219.       WriteS (Out, ": ");
  220.       CASE InfoClass OF
  221.       | Integer    : PtrToInteger    := Info; WriteI (Out, PtrToInteger^, 0);
  222.       | Short      : PtrToShort    := Info; WriteI (Out, PtrToShort^, 0);
  223.       | Long       : PtrToLong    := Info; WriteI (Out, PtrToLong^, 0);
  224.       | Real       : PtrToReal    := Info; WriteR (Out, PtrToReal^, 1, 10, 1);
  225.       | Boolean    : PtrToBoolean    := Info; WriteB (Out, PtrToBoolean^);
  226.       | Character:PtrToCharacter:= Info; WriteC (Out, PtrToCharacter^);
  227.       | String    : PtrToString    := Info; Strings.WriteS (Out, PtrToString^);
  228.       | Array    : PtrToArray    := Info; WriteS (Out, PtrToArray^);
  229.       | Set    : PtrToSet    := Info; WriteSet (Out, PtrToSet^);
  230.       | Ident    : PtrToIdent    := Info; WriteIdent (Out, PtrToIdent^);
  231.       ELSE
  232.       END;
  233.    END WriteInfo;
  234.  
  235. PROCEDURE WriteMessage    (IsErrorCode: BOOLEAN; ErrorCode, ErrorClass: CARDINAL;
  236.              Position: tPosition; InfoClass: CARDINAL; Info: ADDRESS);
  237.    BEGIN
  238.       WriteHead (Position, ErrorClass);
  239.       IF IsErrorCode THEN
  240.      WriteCode (ErrorCode);
  241.       ELSE
  242.      WriteIdent (Out, ErrorCode);
  243.       END;
  244.       WriteInfo (InfoClass, Info);
  245.       WriteNl (Out);
  246.       IF (ErrorClass = Fatal) AND NOT IsStore THEN Exit; END;
  247.    END WriteMessage;
  248.  
  249. PROCEDURE WriteMessages    (File: tFile);
  250.    VAR i    : INTEGER;
  251.    VAR Info    : ADDRESS;
  252.    VAR s    : tString;
  253.    BEGIN
  254.       Sort (1, MessageCount, IsLess, Swap);
  255.       Out := File;
  256.       FOR i := 1 TO MessageCount DO
  257.      WITH ErrorTable [i] DO
  258.         CASE InfoClass OF
  259.         | Integer    : Info := ADR (vInteger    );
  260.         | Short    : Info := ADR (vShort    );
  261.         | Long    : Info := ADR (vLong    );
  262.         | Real    : Info := ADR (vReal    );
  263.         | Boolean    : Info := ADR (vBoolean    );
  264.         | Character    : Info := ADR (vCharacter);
  265.         | String    : GetString (vString, s); Info := ADR (s);
  266.         | Set    : Info :=      vSet     ;
  267.         | Ident    : Info := ADR (vIdent    );
  268.         ELSE
  269.         END;
  270.         WriteMessage (IsErrorCode, ErrorCode, ErrorClass, Position, InfoClass, Info);
  271.      END;
  272.       END;
  273.       Out := StdError;
  274.    END WriteMessages;
  275.  
  276. PROCEDURE StoreMessage    (pIsErrorCode: BOOLEAN; pErrorCode, pErrorClass: CARDINAL;
  277.              pPosition: tPosition; pInfoClass: CARDINAL; pInfo: ADDRESS);
  278.    VAR
  279.       PtrToInteger    : POINTER TO INTEGER    ;
  280.       PtrToShort    : POINTER TO SHORTCARD    ;
  281.       PtrToLong        : POINTER TO LONGINT    ;
  282.       PtrToReal        : POINTER TO REAL    ;
  283.       PtrToBoolean    : POINTER TO BOOLEAN    ;
  284.       PtrToCharacter    : POINTER TO CHAR    ;
  285.       PtrToString    : POINTER TO tString    ;
  286.       PtrToArray    : POINTER TO tArray    ;
  287.       PtrToSet        : POINTER TO tSet    ;
  288.       PtrToIdent    : POINTER TO tIdent    ;
  289.       s            : tString        ;
  290.    BEGIN
  291.       IF MessageCount < MaxError THEN
  292.      INC (MessageCount);
  293.      WITH ErrorTable [MessageCount] DO
  294.         Position    := pPosition    ;
  295.         IsErrorCode    := pIsErrorCode    ;
  296.         ErrorNumber    := MessageCount    ;
  297.         ErrorCode    := pErrorCode    ;
  298.         ErrorClass    := pErrorClass    ;
  299.         InfoClass    := pInfoClass    ;
  300.         CASE InfoClass OF
  301.         | Integer    : PtrToInteger    := pInfo; vInteger    := PtrToInteger    ^;
  302.         | Short    : PtrToShort    := pInfo; vShort    := PtrToShort    ^;
  303.         | Long    : PtrToLong    := pInfo; vLong        := PtrToLong    ^;
  304.         | Real    : PtrToReal    := pInfo; vReal        := PtrToReal    ^;
  305.         | Boolean    : PtrToBoolean    := pInfo; vBoolean    := PtrToBoolean    ^;
  306.         | Character    : PtrToCharacter:= pInfo; vCharacter    := PtrToCharacter^;
  307.         | String    : PtrToString    := pInfo; vString    := PutString (PtrToString^);
  308.         | Array    : PtrToArray    := pInfo; ArrayToString (PtrToArray^, s);
  309.               InfoClass    := String;vArray    := PutString (s);
  310.         | Set    : PtrToSet    := pInfo; vSet        := Alloc (TSIZE (tSet));
  311.                           MakeSet (vSet^, Size (PtrToSet^));
  312.                           Assign  (vSet^, PtrToSet^);
  313.         | Ident    : PtrToIdent    := pInfo; vIdent    := PtrToIdent    ^;
  314.         ELSE
  315.         END;
  316.      END;
  317.       ELSE
  318.      WITH ErrorTable [MessageCount] DO
  319.         IsErrorCode    := TRUE        ;
  320.         ErrorCode    := TooManyErrors;
  321.         ErrorClass    := Restriction    ;
  322.         InfoClass    := None        ;
  323.      END;
  324.       END;
  325.       IF pErrorClass = Fatal THEN WriteMessages (StdError); Exit; END;
  326.    END StoreMessage;
  327.  
  328. PROCEDURE IsLess (i, j: INTEGER): BOOLEAN;
  329.    VAR r: INTEGER;
  330.    BEGIN
  331.       r := Compare (ErrorTable [i].Position, ErrorTable [j].Position);
  332.       IF r = -1 THEN RETURN TRUE ; END;
  333.       IF r = +1 THEN RETURN FALSE; END;
  334.       RETURN ErrorTable [i].ErrorNumber < ErrorTable [j].ErrorNumber;
  335.    END IsLess;
  336.  
  337. PROCEDURE Swap (i, j: INTEGER);
  338.    VAR t: tError;
  339.    BEGIN
  340.       t := ErrorTable [i]; ErrorTable [i] := ErrorTable [j]; ErrorTable [j] := t;
  341.    END Swap;
  342.  
  343. PROCEDURE StoreMessages (Store: BOOLEAN);
  344.    BEGIN
  345.       IF Store THEN
  346.      HandleMessage := StoreMessage;
  347.      MessageCount  := 0;
  348.       ELSE
  349.      HandleMessage := WriteMessage;
  350.       END;
  351.       IsStore := Store;
  352.    END StoreMessages;
  353.  
  354. PROCEDURE yyExit;
  355.    BEGIN
  356.       CloseIO; System.Exit (1);
  357.    END yyExit;
  358.  
  359. BEGIN
  360.    Exit        := yyExit;
  361.    IsStore    := FALSE;
  362.    Out        := StdError;
  363.    HandleMessage:= WriteMessage;
  364. END Errors.
  365.